home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Overload Trio 2
/
Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO
/
dir42
/
c7105.zip
/
LIST.TPX
< prev
next >
Wrap
Text File
|
1994-03-02
|
26KB
|
543 lines
#!┌───────────────────────────┤Template Segment├───────────┬─────────────────┐
#!│ List.TPX │Version: 3007.105│
#!├───────────────────────────────┤Contents├───────────────┴─────────────────┤
#!│Structure Type Description │
#!│──────────────────── ───────── ─────────────────────────────────────────│
#!│List PROCEDURE Scroll records from a file from a memory │
#!│ queue │
#!│ShowFileProgress GROUP │
#!│ListErrorCheck GROUP │
#!│BuildListIndex GROUP │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.103 Repaired the LIST Procedure │
#!│3007.105 Repaired the LIST Procedure │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#PROCEDURE(List,'Scroll all selected records from a file'),SCREEN,PULLDOWN
#!
#!┌──────────────────────────┤Procedure Template├──────────┬─────────────────┐
#!│ List │Version: 3007.103│
#!├──────────────────────────────┤Description├─────────────┴─────────────────┤
#!│ The List template loads the entire set of selected records into │
#!│ a memory queue for displaying with a list box structure. │
#!│ │
#!│ Since the entire queue is filled at load time, this template should │
#!│ not be used with very large files as they may overflow the primary │
#!│ virtual memory area and spill over to disk. The result would be │
#!│ a listbox which works very slow and accesses the hard disk drive when │
#!│ scrolling. │
#!│ │
#!│ A checkbox is available to view a file in Record order. This is │
#!│ primarily useful in viewing ASCII, DOS, or BASIC files. │
#!│ (The View template may also be used.) │
#!│ │
#!│ If the Record Order checkbox is on, any reference to the │
#!│ PrimaryKey is ignored. Deletes, and Updates may not be allowed │
#!│ with certain non-keyed data file types. │
#!│ │
#!│ Also, a checkbox is available to display the queue in reverse │
#!│ order. If both the Record Order checkbox, and the Reverse Order │
#!│ checkbox are on then the file will be displayed in Reverse record │
#!│ order. If Just the Reverse Order checkbox is on, the file │
#!│ will be displayed in Reverse key order. │
#!│ │
#!│ Use with an Update Procedure: │
#!│ │
#!│ Since a Form template allows the multiple add ability, and │
#!│ since a List procedure may be used on a network, a checkbox │
#!│ has been added to control the rebuilding of the queue upon │
#!│ return from the Update Procedure. When checked, the queue │
#!│ will always be rebuilt to accomodate any updates made by other │
#!│ network file users, or multiple record adds by another procedure. │
#!├───────────────────────────────┤Comments├─────────────────────────────────┤
#!│Version Comments │
#!│──────── ────────────────────────────────────────────────────────────────│
#!│3007.000 Release of CDD3 version 3007 templates │
#!│3007.103 Added 'Process Selected Record' code in the CASE FIELD() of List│
#!│ code, specifically to be used if the Hot Fields are enable. │
#!│3007.105 Competed support for PullDowns │
#!└──────────────────────────────────────────────────────────────────────────┘
#!
#PROMPT('Range &Limit Field',COMPONENT),%KeyRangeField
#PROMPT('Range &Value Field',FIELD),%RangeValue
#PROMPT('Record Filter',@S180),%RecordFilter
#PROMPT('Upd&ate Procedure',PROCEDURE),%UpdateProc
#PROMPT('Enable Hot Records',CHECK),%HotBar
#PROMPT('&Queue Rebuild',CHECK),%QueueRebuild
#PROMPT('Record Order',CHECK),%RecordOrder
#PROMPT('Reverse Order',CHECK),%ReverseOrder
#PROMPT('Progress &Indicator',CHECK),%ShowProg
#PROMPT('Progress &Character',@S8),%ProgChar
#PROTOTYPE('')
#INSERT(%StandardHeader)
#INSERT(%SetBrowseSymbols)
#INSERT(%ListErrorCheck)
%Procedure PROCEDURE
Queue QUEUE !Listbox Queue contains
FilePointer Ulong
#FIX(%File,%Primary)
#FIX(%Key,%PrimaryKey)
#SET(%FirstField, %Null)
#FOR(%KeyField)
QUE::%KeyField LIKE(%KeyField) #<! And Key element(s) for sort
#IF(%FirstField = %Null)
#SET(%FirstField, %KeyField)
#SET(%FirstFieldSequence, %KeyFieldSequence)
#ENDIF
#IF(%RecordOrder = %Null)
#IF(%KeyFieldSequence <> 'DESCENDING' AND %ReverseOrder = %Null)
#SET(%SortString, (CLIP(LEFT(%SortString)) & ',+QUE::' & %KeyField))
#ELSE
#SET(%SortString, (CLIP(LEFT(%SortString)) & ',-QUE::' & %KeyField))
#ENDIF
#ENDIF
#ENDFOR
#IF((%RecordOrder AND %ReverseOrder))
#SET(%SortString,(','& %FixRows+1))
#ENDIF
#FIX(%ScreenField,'?LIST')
Line STRING(%ScreenFieldQueueSize) #<! Line to be scrolled
.
#INSERT(%SetupKeyRangeFields)
ButtonIsDisabled BYTE !Flag to allow button enable
#INSERT(%FileControl)
InitialLoad BYTE(1)
%LocalData
%ScreenStructure
#IF(%PullDown)
%PulldownStructure
SAV::PullDownOpened BYTE(0)
#ENDIF
#EMBED('Data Section')
PreUpdateCount ULONG !Records in file count.
FirstPage BYTE !First page flag
#IF(%ShowProg)
VEW::Length BYTE ! Progress variable
VEW::ProgString STRING('<176>{80}') ! Progress display variable
#ENDIF
CODE
#EMBED('Setup Procedure')
#INSERT(%FileControl)
OPEN(Screen) !Open the screen
#EMBED('Setup Screen')
DISPLAY !Display screen fields
#IF(%Pulldown) #!If a Pulldown exists
OPEN(%Pulldown) #<!Open the Pulldown
SAV::PullDownOpened = True
#EMBED('Setup Pulldown')
#ENDIF
#INSERT(%BuildListIndex)
IF ?LIST = %FirstEntryField #<!If no entry for ranges
DO FillQueue ! Fill the QUEUE
IF RECORDS(Queue) = %FixRows #<! If no QUEUE records
#IF(%InsertExists)
SELECT(?Insert) ! Select the Insert button
#ELSIF(%UpdateProc)
#INSERT(%RestoreRangeFields)
SETKEYCODE(InsKey) ! Set action to Insert
Do UpdateProcedure ! Call the update procedure
DO FillQueue ! Fill the QUEUE
IF RECORDS(Queue) = %FixRows #<! If still no records
DO ProcedureReturn
END ! End IF
#ELSE
DO ProcedureReturn
#ENDIF
END ! End IF
END !End IF
#IF(%HotBar)
#SET(%FirstRecordRow,(%FixRows+1))
GET(Queue,%FirstRecordRow)
GET(%Primary,FilePointer)
DISPLAY()
#ENDIF
LOOP !Screen handling loop
#FOR(%Formula)
#IF(UPPER(%FormulaClass) <> 'LIST')
#IF(UPPER(%FormulaClass) <> 'FILTER')
#INSERT(%GenerateFormula)
#ENDIF
#ENDIF
#ENDFOR
#EMBED('End of General Formulas')
CASE SELECTED() !Jump to field setup routine
#INSERT(%ScreenSetupRoutines)
END !End CASE
ACCEPT !Enable the keyboard
CASE KEYCODE() !Jump to hotkey procedures
#FOR(%HotKey)
OF %HotKey !User defined HotKey
%HotKeyProc !HotKey Procedure
#ENDFOR
#FIX(%ScreenField,'?Exit')
#IF(%ScreenField)
OF EscKey
IF FIELD() <> ?Exit
SELECT(?Exit)
PRESS(EnterKey)
CYCLE
END
#ENDIF
END !End CASE
IF REFER() AND SELECTED() = ?List | !If list field is selected
AND FIELD() < ?List ! From a prior changed field
DO FillQueue ! Fill the QUEUE
END !End IF
CASE FIELD() !Jump to edit routine
#FOR(%ScreenField)
#IF(%ScreenField = '?Insert')
#IF(%UpdateProc)
OF ?Insert !Process the Insert Button
#IF(%ScreenFieldEdit)
%ScreenFieldEdit #<! Insert button Edit Routine
#ENDIF
GET(%Primary,0) #<! Dereference current record
#INSERT(%ClearFileFields)
#INSERT(%RestoreRangeFields)
PreUpdateCount = Records(%Primary) #<! Save a record count
SETKEYCODE(InsKey) ! Set action to Insert
Do UpdateProcedure ! Call the update procedure
#IF(%QueueRebuild)
Do FillQueue ! Fill the QUEUE
#ELSE
CASE RECORDS(%Primary) #<! Check the record count
OF PreUpdateCount ! If no change
SELECT(?List) ! Reselect the list box
OF PreUpdateCount + 1 ! If 1 record added
#FIX(%ScreenField,'?List')
Line = %ScreenFieldExpression #<! Fill the QUEUE line
FilePointer = POINTER(%Primary) #<! Save the file pointer
#INSERT(%FillKeyValues)
ADD(Queue %SortString) #<! Add the record sorted
ELSE ! Otherwise
Do FillQueue ! Rebuild the QUEUE
END ! End CASE
#ENDIF
SELECT(?List) ! Reselect the List field
#ENDIF
#ENDIF
#IF(%ScreenField = '?Change')
#IF(%UpdateProc)
OF ?Change !Process the Change Button
#IF(%ScreenFieldEdit)
%ScreenFieldEdit #<! Change button Edit Routine
#ENDIF
GET(Queue,CHOICE(?List)) !Get the QUEUE element
GET(%Primary,FilePointer) #<!Get the record
SETKEYCODE(EnterKey) ! Set action to Change
Do UpdateProcedure ! Call the update procedure
#IF(%QueueRebuild)
Do FillQueue ! Fill the QUEUE
#ENDIF
#IF(%HotBar)
GET(Queue,CHOICE(?List)) !Get the QUEUE element
GET(%Primary,FilePointer) #<!Get the record
#ENDIF
SELECT(?List) ! Reselect the List field
#ENDIF
#ENDIF
#IF(%ScreenField = '?Delete')
#IF(%UpdateProc)
OF ?Delete !Process the Delete Button
#IF(%ScreenFieldEdit)
%ScreenFieldEdit #<! Delete button Edit Routine
#ENDIF
GET(Queue,CHOICE(?List)) ! Get the QUEUE element
GET(%Primary,FilePointer) #<! Get the record
SETKEYCODE(DelKey) ! Set action to Delete
Do UpdateProcedure ! Call the update procedure
#IF(%QueueRebuild)
Do FillQueue ! Fill the QUEUE
#ENDIF
#IF(%HotBar)
GET(Queue,CHOICE(?List)) ! Get the QUEUE element
GET(%Primary,FilePointer) #<! Get the record
#ENDIF
SELECT(?List) ! Reselect the List field
#ENDIF
#ENDIF
#IF(%ScreenField = '?List')
OF ?List !Process the list field
#IF(%HotBar)
GET(Queue,CHOICE(?List)) ! Get the QUEUE element
GET(%Primary,FilePointer) #<! Get the record
#ENDIF
#IF(%ScreenFieldEdit)
%ScreenFieldEdit #<! Exit button Edit Routine
#ENDIF
#IF(%HotBar)
#EMBED('Process Selected Record')
DISPLAY() #<! Display the hot fields
#ENDIF
#IF(%UpdateProc)
CASE KEYCODE() ! Jump to keycode routine
#IF(%NoButtonsExist OR %InsertExists)
OF InsKey ! For the insert key
GET(%Primary,0) #<! Dereference current record
#INSERT(%ClearFileFields)
#INSERT(%RestoreRangeFields)
PreUpdateCount = Records(%Primary) #<! Save a record count
Do UpdateProcedure ! Call the update procedure
#IF(%QueueRebuild)
Do FillQueue ! Fill the QUEUE
#ELSE
CASE RECORDS(%Primary) #<! Check the record count
OF PreUpdateCount ! If no change
SELECT(?List) ! Reselect the list box
OF PreUpdateCount + 1 ! If 1 record added
#FIX(%ScreenField,'?List')
Line = %ScreenFieldExpression #<! Fill the QUEUE line
FilePointer = POINTER(%Primary) #<! Save the file pointer
#INSERT(%FillKeyValues)
ADD(Queue %SortString) #<! Add the record sorted
ELSE ! Otherwise
Do FillQueue ! Rebuild the QUEUE
END ! End CASE
#ENDIF
SELECT(?List) ! Reselect the List field
#ENDIF
#IF(%NoButtonsExist OR %DeleteExists)
OF DelKey ! For the delete key
PreUpdateCount = Records(%Primary) ! Save a record count
GET(Queue,CHOICE(?List)) ! Get the QUEUE element
GET(%Primary,FilePointer) #<! Get the record
Do UpdateProcedure ! Call the update procedure
#IF(%QueueRebuild)
Do FillQueue ! Fill the QUEUE
#ELSE
IF RECORDS(%Primary) = PreUpdateCount -1 #<! If the record was deleted
DELETE(Queue) ! Delete the Queue entry
END ! End IF
#ENDIF
#ENDIF
#IF(%HotBar)
GET(Queue,CHOICE(?List)) ! Get the QUEUE element
GET(%Primary,FilePointer) #<! Get the record
#ENDIF
#IF(%NoButtonsExist OR %ChangeExists )
OF EnterKey ! Or the enter key
OROF MouseLeft2 ! Or a double mouse click
GET(Queue,CHOICE(?List)) ! Get the QUEUE element
GET(%Primary,FilePointer) #<! Get the record
Do UpdateProcedure ! Call the update procedure
#IF(%QueueRebuild)
Do FillQueue ! Fill the QUEUE
#ENDIF
#ENDIF
#IF(%HotBar)
GET(Queue,CHOICE(?List)) ! Get the QUEUE element
GET(%Primary,FilePointer) #<! Get the record
#ENDIF
END ! End CASE keycode
#ENDIF
#ELSIF(%ScreenField = '?Exit')
OF ?Exit !Process the Exit button
#IF(%ScreenFieldEdit)
%ScreenFieldEdit #<! Exit button Edit Routine
#ENDIF
DO ProcedureReturn
#ELSE
#INSERT(%ScreenEditRoutines)
#ENDIF
#ENDFOR
#INSERT(%PulldownEditRoutines)
END !End CASE FIELD()
DISPLAY
END !End LOOP
DO ProcedureReturn
FillQueue Routine
#EMBED('Start of Fill Queue Routine')
FREE(Queue) #<!Clear the QUEUE
Firstpage = 1 !Set the FirstPage flag
#IF(%ShowProg) #!If showing the progress
VEW::Length = 1 !Set the status bar counter
#ENDIF
#FIX(%ScreenField,'?List')
#FOR(%ScreenFieldFix)
Line = %ScreenFieldFix #<!Add list box fields
#IF(%RecordOrder = %Null)
#IF(%FirstFieldSequence <> 'DESCENDING' AND %ReverseOrder = %Null)
CLEAR(QUE::%FirstField) #<!Clear the key field
#ELSE
CLEAR(QUE::%FirstField,1) #<!Clear the key field
#ENDIF
#ENDIF
ADD(Queue) !Add the fixed line
DISPLAY(?List) #<!Blank the listbox
#ENDFOR
#IF(%RecordOrder)
SET(%Primary) #<!Set to file order
#ELSIF(%KeyRangeField)
#IF(%ReverseOrder)
#INSERT(%ClearRecordHigh)
#ELSE
#INSERT(%ClearRecordLow)
#ENDIF
%KeyRangeField = %RangeValue #<!Fill range field
SET(%PrimaryKey,%PrimaryKey) #<!Set to keyed order
#ELSE
SET(%PrimaryKey) #<!Set to keyed order
#ENDIF
#IF(%ShowProg) #!If showing the progress
VEW::ProgString = ALL(%ProgChar) #<!Fill the progress string
#ENDIF
LOOP !Get all selected records
#IF(%RecordOrder)
NEXT(%Primary) #<! Get the next record.
#ELSIF(%ReverseOrder)
PREVIOUS(%Primary) #<! Get the previous record
#ELSE
NEXT(%Primary) #<! Get the next record.
#ENDIF
IF ERRORCODE() THEN BREAK. ! Quit if an error occurs
#FIX(%File,%Primary)
#FIX(%Key,%PrimaryKey)
#IF(%KeyRangeField) #!If using a Range
#IF(%KeyNoCase) #! Key is not case sensitive
IF (UPPER(%KeyRangeField) <> UPPER(%RangeValue)) #<! If not in Range
#ELSE
IF (%KeyRangeField <> %RangeValue) #<! If not in Range
#ENDIF
BREAK #<! Break out of the Loop
END ! End IF
#ENDIF
#IF(%RecordFilter)
IF ~(%RecordFilter) #<! If Filter condition not met
CYCLE ! Try another record
END ! End IF
#ELSE
#FOR(%Formula)
#IF(UPPER(%FormulaClass) = 'FILTER')
#IF(%FormulaType <> 'COMPUTED')
IF ~(%FormulaCondition) #<! If Filter condition not met
CYCLE ! Try another record
END ! End IF
#ELSE
IF ~(%FormulaComputation) #<! If Filter condition not met
CYCLE ! Try another record
END ! End IF
#ENDIF
#ENDIF
#ENDFOR
#ENDIF
#INSERT(%GetSecondaryRecords)
#FOR(%Formula)
#IF(UPPER(%FormulaClass) = 'LIST')
#INSERT(%GenerateFormula)
#ENDIF
#ENDFOR
#EMBED('LIST Class formula')
#IF(%ShowProg) #!If showing the progress
#INSERT(%ShowFileProgress) #!Insert the progress code
#ENDIF
#FIX(%ScreenField,'?LIST')
Line = %ScreenFieldExpression #<! Fill the QUEUE line
FilePointer = POINTER(%Primary) #<! Fill the file pointer
#FOR(%KeyField)
QUE::%KeyField =%KeyField #<! Fill the key field
#ENDFOR
ADD(Queue %SortString) #<! Add to the QUEUE
IF ERRORCODE() THEN BREAK. ! Quit out if error
IF FirstPage ! If page 1
IF RECORDS(Queue) = ROWS(?List) ! If we have a full screen
FirstPage = 0 ! turn off the page flag
END ! End IF
DISPLAY(?List) ! Display page 1
END ! End IF
LOOP WHILE KEYBOARD() ! While Keyboard Input
SELECT(?List) ! Select the List box
ACCEPT ! Accept a Key
IF KEYCODE() = EscKey ! If the Escape key
DO ProcedureReturn
END ! End IF
DISPLAY(?List) ! Redisplay the list box
END ! End LOOP
END !End LOOP
#IF(%ShowProg) #!If showing the progress
CLEAR(StatusLine)
DISPLAY(?StatusLine)
#ENDIF
EXIT
#IF(%UpdateProc)
UpdateProcedure ROUTINE
#EMBED('Prior to Update Procedure')
%UpdateProc
#EMBED('After Update Procedure')
#ENDIF
#!
!─────────────────────────────────────────────────────────────────────────────
ProcedureReturn ROUTINE
#IF(%ShowProg) #!If showing the progress
ERASE(?StatusLine) !Clear the StatusLine
#ENDIF
DISPLAY !Redisplay the screen
FREE(Queue) !Free the Queue memory
#IF(%Pulldown) #!If a Pulldown exists
IF SAV::PullDownOpened
CLOSE(%Pulldown) #<!Close the Pulldown
END
#ENDIF
CLOSE(%Screen)
#INSERT(%FileControl)
DO EndOfProcedureEmbed
RETURN
!─────────────────────────────────────────────────────────────────────────────
EndOfProcedureEmbed ROUTINE
#EMBED('End of Procedure')
#EMBED('Custom Routines')
#!***************************************************************************
#GROUP(%ShowFileProgress)
VEW::Length += 1
StatusLine = ' Reading File: ' & SUB(VEW::ProgString,1,VEW::Length)
IF VEW::Length = LEN(StatusLine) - 15
VEW::Length = 1
StatusLine = ' Reading File: ' & ' {65}'
END
Display(?StatusLine)
#!
#!***************************************************************************
#GROUP(%ListErrorCheck)
#!
#IF(%Primary = %Null)
#SET(%ErrorMessage, (%Procedure & ' ERROR: No file has been chosen for this procedure.'))
#ERROR(%ErrorMessage)
#SET(%ErrorMessage, ' A file must be identified on the File Schematic.')
#ERROR(%ErrorMessage)
#ENDIF
#IF(%KeyRangeField)
#IF(UPPER(%KeyRangeField) = UPPER(%RangeValue))
#SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limit Field and Range Value fields must'))
#ERROR(%ErrorMessage)
#SET(%ErrorMessage, ' be separate fields.')
#ERROR(%ErrorMessage)
#ENDIF
#IF(%KeyRangeField <> %Null and %RecordOrder <> %Null)
#SET(%ErrorMessage, (%Procedure & ' ERROR: Range Limits may only be used with keyed order.'))
#ERROR(%ErrorMessage)
#SET(%ErrorMessage, ' Record order has been selected.')
#ERROR(%ErrorMessage)
#ENDIF
#ENDIF
#!
#!***************************************************************************
#GROUP(%BuildListIndex)
#FIX(%File, %Primary)
#FIX(%Key, %PrimaryKey)
#IF(%KeyIndex)
BUILD(%PrimaryKey) #<!Build the index
#ENDIF
#!
#!***************************************************************************
#CHAIN('LOOKUP.TPX')